home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 1471 / clsccont.cls next >
Text File  |  1997-02-11  |  3KB  |  109 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = 0   'False
  4. END
  5. Attribute VB_Name = "clscContacts"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = True
  8.  
  9. Option Explicit
  10.  
  11. Private colData As New Collection
  12. 'Requred property (or function)
  13. Public Property Get Item(Index) As clsContact
  14. Set Item = colData(Index)
  15. End Property
  16.  
  17. 'Requred property (or function)
  18. Public Property Get Count()
  19. Count = colData.Count
  20. End Property
  21.  
  22. Public Sub Add(NewItem As clsContact)
  23. colData.Add NewItem
  24. End Sub
  25. Public Sub Create(Optional Parent)
  26.  
  27. Dim rs As Recordset
  28. Dim qd As QueryDef
  29. Dim qdChildren As QueryDef
  30. Dim rsChilren As Recordset
  31. Dim i As Integer
  32. Dim ctItem As clsContact
  33. On Error Resume Next
  34.  
  35. If IsMissing(Parent) Then 'Top level
  36.     
  37.     Set rs = dbMain.OpenRecordset("ContactTypes")
  38.     
  39.     rs.MoveFirst
  40.     
  41.     For i = 1 To rs.RecordCount
  42.         Set ctItem = New clsContact
  43.         With ctItem
  44.             .Name = rs!ContactType & ""
  45.             .Image = "Folder"
  46.             .HasChildren = rs!HasChildren
  47.         End With
  48.         colData.Add ctItem
  49.         rs.MoveNext
  50.     Next i
  51.     
  52.     rs.Close
  53.     
  54.   Else
  55.     
  56.     Select Case Parent.Image
  57.     
  58.         Case "Folder" 'Folder
  59.             
  60.             Set qd = dbMain.QueryDefs("CompaniesByContactType")
  61.             qd.Parameters(0) = Parent.Name
  62.             Set rs = qd.OpenRecordset()
  63.             rs.MoveLast
  64.             If Err = 3021 Then Exit Sub 'No current record
  65.             rs.MoveFirst
  66.             
  67.             For i = 1 To rs.RecordCount
  68.                 Set ctItem = New clsContact
  69.                 With ctItem
  70.                     .Name = rs!CompanyName & ""
  71.                     .HasChildren = True
  72.                     .Image = "Company"
  73.                 End With
  74.                 colData.Add ctItem
  75.                 rs.MoveNext
  76.             Next i
  77.             
  78.             rs.Close
  79.         
  80.         Case "Company" 'Company
  81.         
  82.             Set qd = dbMain.QueryDefs("ContactsByCompany")
  83.             qd.Parameters(0) = Parent.Name
  84.             Set rs = qd.OpenRecordset()
  85.             rs.MoveLast
  86.             rs.MoveFirst
  87.             
  88.             For i = 1 To rs.RecordCount
  89.                 Set ctItem = New clsContact
  90.                 With ctItem
  91.                     .Name = rs!Name & ""
  92.                     .WorkPhone = rs!WorkPhone & ""
  93.                     .LastMeetingDate = rs!LastMeetingDate
  94.                     .Image = "Contact"
  95.                 End With
  96.                 colData.Add ctItem
  97.                 rs.MoveNext
  98.             Next i
  99.             rs.Close
  100.     End Select
  101.  
  102. End If
  103.  
  104. End Sub
  105.  
  106. Private Sub Class_Initialize()
  107. If dbMain Is Nothing Then Set dbMain = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\Sample")
  108. End Sub
  109.